home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: Games / PC-SIG Games (PC-SIG).iso / 1938 / GAMES.ZOO / hypocycl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-06-04  |  1.6 KB  |  57 lines
  1. program hypocycloid;
  2. {
  3.    A hypocycloid is a figure created by rolling a circle inside another.
  4.    this program is adapted from a program on p.97 of MS quickC manual.
  5.  
  6.    This source will produce the same program as HYPOCYCL.EXE, except
  7.    this version will require the appropriate .BGI file.
  8.  
  9.    stephen peter 1988
  10. }
  11. uses Crt, Graph, Dos;
  12. var
  13.    Graphdriver, GraphMode      : integer;
  14.    x0, y0, maxx, maxy, x, y, i : integer;
  15.    colour, start_colour        : word;
  16.    ratio, a, b, h, penpos, ang : real;
  17. {-------------------------------------------------------------------}
  18. begin
  19.   GraphDriver := detect;
  20.   initgraph (GraphDriver,GraphMode,'');
  21.  
  22.   maxx := GetMaxX;
  23.   maxy := GetMaxY;
  24.   x0 := trunc(maxx/2 -1);
  25.   y0 := trunc(maxy/2 -1);
  26.  
  27.   repeat
  28.      ClearDevice;
  29.      randomize;
  30.      ratio := random*10 + 1;
  31.      penpos := random*10 +1;
  32.  
  33.      a := 0.5 * ratio * maxy / (ratio + penpos -1);
  34.      b := a / ratio;
  35.      h := penpos * b;
  36.  
  37.      start_colour := trunc(random*7)+1;
  38.      ang := 0;
  39.      while not keypressed do
  40.          for i := 1 to 20 do
  41.              begin
  42.                ang := ang + 2*pi/100;
  43.                x := trunc (x0 + (a-b)*cos(ang) + h*cos(ang*(a-b)/b));
  44.                y := trunc (y0 - (a-b)*sin(ang) + h*sin(ang*(a-b)/b));
  45.                colour := getpixel (x,y);
  46.                if colour <> 0 then
  47.                    begin
  48.                      inc (colour);
  49.                      if colour = 15 then colour := 1;
  50.                    end
  51.                else  colour := start_colour;
  52.                putpixel (x,y,colour);
  53.              end;
  54.    until ReadKey in ['Q','q',#27];
  55.    closegraph;
  56. end.
  57.